home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TEXTEDIT.SWG / 0011_Justification Routine.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  3KB  |  71 lines
  1. UNIT JUSTIFY;
  2.  
  3. INTERFACE
  4.  
  5. PROCEDURE JustifyLine (VAR LINE : STRING; Printwidth : BYTE);
  6.  
  7. IMPLEMENTATION
  8.  
  9. PROCEDURE JustifyLine (VAR LINE : STRING; Printwidth : BYTE);
  10. { justify line to a length of printwidth by putting extra blanks between
  11.   words, from right to left.  The line currently has one blank between words.}
  12.  
  13. VAR
  14.    blanks,               {# of blanks to be inserted}
  15.    gaps,                 {# of gaps between words}
  16.    n,                    {amount to expand 1 gap}
  17.    dest,                 {new place for moved char}
  18.    source : INTEGER;     {source column of that char}
  19.    len    : BYTE ABSOLUTE Line;
  20.  
  21. BEGIN {justify}
  22.  
  23.            IF (LINE > '') AND (len < printwidth) THEN
  24.                   BEGIN
  25.                   {set hard spaces for indents}
  26.                   source := 1;
  27.                   WHILE (LINE [source] = ' ') AND (source < len) DO
  28.                         BEGIN
  29.                         LINE [source] := #0;
  30.                         INC(source);
  31.                         END;
  32.  
  33.                   {count # of gaps between words}
  34.                   gaps := 0;
  35.                   FOR source := 1 TO len DO
  36.                       IF LINE [source] = ' ' THEN gaps := SUCC (gaps);
  37.  
  38.                   {find # of blanks needed to stretch the line}
  39.                   blanks := printwidth - len;
  40.                   {shift characters to the right, distributing extra blanks}
  41.                   {between the words (in the gaps)}
  42.                   dest := printwidth;
  43.                   source := len;
  44.                   WHILE gaps > 0 DO
  45.                         BEGIN {expand line}
  46.                         IF LINE [source] <> ' ' THEN
  47.                            BEGIN {shift char}
  48.                            LINE [dest] := LINE [source];   {move char, leave blank}
  49.                            LINE [source] := ' ';
  50.                            END
  51.                         ELSE
  52.                            BEGIN  {leave blanks}
  53.                            {find # of blanks for this gap, skip that many}
  54.                            {(now blank) columns}
  55.                            n := blanks DIV gaps;
  56.                            dest := dest - n;
  57.                            gaps := PRED (gaps);
  58.                            blanks := blanks - n;
  59.                            END;
  60.                         {step to next source and dest characters}
  61.                         source := PRED (source);
  62.                         dest := PRED (dest)
  63.                         END; {expand line}
  64.  
  65.                  LINE[0] := CHR(printwidth);
  66.                  FOR source := 1 TO len DO
  67.                      IF LINE [source] = #0 THEN LINE [source] := #32;
  68.                  END;
  69.  
  70.         END; {justify procedure}
  71. END.